home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 031-040 / amok33 / uclock / uclock.mod < prev    next >
Text File  |  1993-11-04  |  5KB  |  154 lines
  1. (* -------------------------------------------------------------------------
  2.   :Program.       UClock
  3.   :Author.        Holger Bolay
  4.   :Address.       Hoffmannstraße 168, D-7250 Leonberg 1
  5.   :Phone.         07152/22135
  6.   :History.       Version 1.0  : Original translation!
  7.   :History.       Version 1.01 : Beep on the hour
  8.   :History.       Version 1.02 : Clever reorganized
  9.   :History.       Version 1.1  : <unset> Function implemented
  10.   :Copyright.     FreeWare
  11.   :Language.      Modula-2
  12.   :Translator.    M2Amiga 3.2d
  13.   :Imports.       Beep [fbs]
  14.   :Remark.        The Modula-2 Version of Mike Meyer's MClk.
  15.   :Remark.        My first Modula-program (Don't laugh) - may help beginners!
  16.   :Contents.      Small window which Shows Time & Memory.
  17. ------------------------------------------------------------------------- *)
  18. MODULE UClock;
  19.  
  20. FROM SYSTEM       IMPORT ADR;
  21. FROM Arts         IMPORT Assert, TermProcedure, Terminate, CurrentLevel;
  22. FROM Conversions  IMPORT ValToStr;
  23. FROM Str          IMPORT Length, Copy, Concat;
  24. FROM Dos          IMPORT Date, DateStamp, Delay;
  25. FROM Exec         IMPORT Byte, AvailMem, MemReqSet, MemReqs, GetMsg, ReplyMsg,
  26.                          TaskPtr, SetTaskPri, FindTask;
  27. FROM Graphics     IMPORT RastPortPtr, SetAPen, Text, Move;
  28. FROM Intuition    IMPORT NewWindow, OpenWindow, CloseWindow, WindowPtr,
  29.                          IDCMPFlags, IDCMPFlagSet, WindowFlags, WindowFlagSet,
  30.                          ScreenFlagSet, ScreenFlags, IntuiMessagePtr;
  31. FROM Beep         IMPORT Beep;
  32.  
  33. (* $R- $V- $S- $F- Make it faster and shorter! *)
  34.  
  35. VAR DateWindowPtr                    : WindowPtr;
  36.     DateRPortPtr                     : RastPortPtr;
  37.     chipMem, fastMem                 : LONGINT;
  38.     Hour, Minute, Second             : LONGINT;
  39.     chipStr, fastStr                 : ARRAY [1..4] OF CHAR;
  40.     HourStr, MinuteStr, SecondStr    : ARRAY [1..2] OF CHAR;
  41.     VTSerr                           : BOOLEAN;
  42.     AllTogether                      : ARRAY [1..50] OF CHAR;
  43.     IntuiMsgPtr                      : IntuiMessagePtr;
  44.     class                            : IDCMPFlagSet;
  45.     Time                             : Date;
  46.  
  47.  
  48. PROCEDURE CloseDown;
  49.  
  50. BEGIN
  51.    IF DateWindowPtr # NIL THEN
  52.       CloseWindow(DateWindowPtr);
  53.       DateWindowPtr := NIL;
  54.    END; (* IF *)
  55. END CloseDown;
  56.  
  57.  
  58. PROCEDURE Init;
  59.  
  60. VAR DateWindow   : NewWindow;
  61.     OldPri       : Byte;
  62.     ClockTaskPtr : TaskPtr;
  63.  
  64. BEGIN
  65.    TermProcedure(CloseDown);
  66.    ClockTaskPtr := FindTask(NIL);
  67.    Assert(ClockTaskPtr # NIL, ADR("Can't find Task!?!"));
  68.    OldPri := SetTaskPri(ClockTaskPtr, 20);
  69.    WITH DateWindow DO
  70.       leftEdge := 223; topEdge := 0;
  71.       width := 369; height := 10;
  72.       detailPen := 0; blockPen := 1;
  73.       idcmpFlags := IDCMPFlagSet{closeWindow};
  74.       flags := WindowFlagSet{windowDepth, windowDrag, windowClose,
  75.                              rmbTrap, windowRefresh, noCareRefresh};
  76.       firstGadget := NIL;
  77.       checkMark := NIL;
  78.       title := NIL;
  79.       screen := NIL;
  80.       bitMap := NIL;
  81.       minWidth := 0; minHeight := 0;
  82.       maxWidth := 0; maxHeight := 0;
  83.       type := ScreenFlagSet{wbenchScreen};
  84.    END; (* WITH *)
  85.    DateWindowPtr := OpenWindow(DateWindow);
  86.    Assert(DateWindowPtr # NIL, ADR("Unable to open Date-Window!"));
  87.    DateRPortPtr := DateWindowPtr^.rPort;
  88.    SetAPen(DateRPortPtr, 1);
  89. END Init;
  90.  
  91.  
  92. PROCEDURE Concatenation;
  93.  
  94. BEGIN
  95.    chipMem := AvailMem(MemReqSet{chip}) DIV 1024;
  96.    fastMem := AvailMem(MemReqSet{fast}) DIV 1024;
  97.    DateStamp(ADR(Time));
  98.    Hour := Time.minute DIV 60;
  99.    Minute := Time.minute MOD 60;
  100.    Second := Time.tick DIV 50;
  101.    ValToStr(chipMem, FALSE, chipStr, 10, 3, ' ', VTSerr);
  102.    ValToStr(fastMem, FALSE, fastStr, 10, 4, ' ', VTSerr);
  103.    ValToStr(Hour, FALSE, HourStr, 10, 2, ' ', VTSerr);
  104.    ValToStr(Minute, FALSE, MinuteStr, 10, 2, '0', VTSerr);
  105.    ValToStr(Second, FALSE, SecondStr, 10, 2, '0', VTSerr);
  106.    Copy(AllTogether, " Chip:");
  107.    Concat(AllTogether, chipStr);
  108.    Concat(AllTogether, "  ");
  109.    Concat(AllTogether, "Fast:");
  110.    Concat(AllTogether, fastStr);
  111.    Concat(AllTogether, "  ");
  112.    Concat(AllTogether, "Time:");
  113.    IF Time.days # 0 THEN
  114.       Concat(AllTogether, HourStr);
  115.       Concat(AllTogether, ":");
  116.       Concat(AllTogether, MinuteStr);
  117.       Concat(AllTogether, ":");
  118.       Concat(AllTogether, SecondStr);
  119.       Concat(AllTogether, " ");
  120.    ELSE
  121.       Concat(AllTogether, " <unset> ");
  122.    END; (* IF *)
  123. END Concatenation;
  124.  
  125.  
  126. BEGIN
  127.    Init;
  128.    LOOP
  129.       Delay(15);
  130.       Concatenation;
  131.       Move(DateRPortPtr, 28, 7);
  132.       Text(DateRPortPtr, ADR(AllTogether), Length(AllTogether));
  133.       IntuiMsgPtr := GetMsg(DateWindowPtr^.userPort);
  134.       IF (Second = 0) AND (Minute = 0) THEN
  135.          Beep(FALSE);
  136.          REPEAT
  137.             Delay(1);
  138.             DateStamp(ADR(Time));
  139.             Second := Time.tick DIV 50;
  140.          UNTIL (Second # 0);
  141.       END; (* IF *)
  142.       IF Time.days = 0 THEN
  143.          Beep(TRUE);
  144.       END; (* IF *)
  145.       IF IntuiMsgPtr # NIL THEN
  146.          class := IntuiMsgPtr^.class;
  147.          ReplyMsg(IntuiMsgPtr);
  148.          IF (closeWindow IN class) THEN
  149.             Terminate(CurrentLevel());
  150.          END; (* IF *)
  151.       END; (* IF *)
  152.    END; (* LOOP *)
  153. END UClock.
  154.